home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / Demos / AirHockey / modDInput.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-08  |  5.7 KB  |  159 lines
  1. Attribute VB_Name = "modDInput"
  2. Option Explicit
  3.  
  4. Private Enum DefaultCameraViews
  5.     DefaultView
  6.     OverHeadView
  7.     SideOverheadView1
  8.     SideOverheadView2
  9.     OpponentView
  10.     CustomView
  11. End Enum
  12.  
  13. Private Const mnMouseSensitivity As Single = 0.02
  14. Private Const mnMaxZThresh As Single = 35
  15. Private Const mnMaxYThresh As Single = 50
  16. Private Const mnMaxXThresh As Single = 35
  17. Private mnLastX As Single
  18. Private mnLastY As Single
  19.  
  20. 'DirectInput variables, etc
  21. Public Const glBufferSize As Long = 10
  22. Public Const gnVelocityBoost As Single = 1.1
  23.  
  24. Public DI As DirectInput8
  25. Public DIMouse As DirectInputDevice8
  26. Public gfMovingCamera As Boolean
  27.  
  28. Public Function InitDInput(oForm As Form) As Boolean
  29.   
  30.   Dim diProp As DIPROPLONG
  31.   
  32.   On Error GoTo FailedInput
  33.   
  34.   InitDInput = True
  35.   Set DI = dx.DirectInputCreate
  36.   Set DIMouse = DI.CreateDevice("guid_SysMouse")
  37.   Call DIMouse.SetCommonDataFormat(DIFORMAT_MOUSE)
  38.   Call DIMouse.SetCooperativeLevel(oForm.hwnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
  39.   
  40.   ' Set the buffer size
  41.   diProp.lHow = DIPH_DEVICE
  42.   diProp.lObj = 0
  43.   diProp.lData = glBufferSize
  44.   Call DIMouse.SetProperty("DIPROP_BUFFERSIZE", diProp)
  45.  
  46.   'Acquire the mouse
  47.   DIMouse.Acquire
  48.   Exit Function
  49.   
  50. FailedInput:
  51.     InitDInput = False
  52.  
  53. End Function
  54.  
  55. Public Sub CleanupDInput()
  56.     On Error Resume Next
  57.     'Unacquire the mouse
  58.     If Not (DIMouse Is Nothing) Then DIMouse.Unacquire
  59.     'Destroy our objects
  60.     Set DIMouse = Nothing
  61.     Set DI = Nothing
  62. End Sub
  63.  
  64. Public Sub ProcessMouseData()
  65.     'This is where we respond to any change in mouse state. Usually this will be an axis movement
  66.     'or button press or release, but it could also mean we've lost acquisition.
  67.  
  68.     Dim diDeviceData(1 To glBufferSize) As DIDEVICEOBJECTDATA
  69.     Dim lNumItems As Long
  70.     Dim lCount As Integer
  71.     Dim vOldPaddle As D3DVECTOR
  72.     Static OldSequence As Long
  73.   
  74.     On Error GoTo INPUTLOST 'In case we lost the mouse
  75.     DIMouse.Acquire 'Just in case
  76.     lNumItems = DIMouse.GetDeviceData(diDeviceData, 0)
  77.      On Error GoTo 0 'Reset our error
  78.     
  79.     vOldPaddle = goPaddle(glMyPaddleID).Position
  80.     ' Process data
  81.     For lCount = 1 To lNumItems
  82.         Select Case diDeviceData(lCount).lOfs
  83.         Case DIMOFS_X 'We moved the X axis
  84.             If gfMovingCamera Then
  85.                 With goCamera.Position
  86.                     .x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
  87.                     goCamera.SetCameraPosition CustomView, glMyPaddleID
  88.                     If Abs(.x) > mnMaxXThresh Then
  89.                         'Whoops too much
  90.                         .x = mnMaxXThresh * (.x / Abs(.x))
  91.                     End If
  92.                 End With
  93.             Else
  94.                 goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
  95.                 With goPaddle(glMyPaddleID).Position
  96.                     .x = .x + (diDeviceData(lCount).lData * mnMouseSensitivity)
  97.                     If .x > (gnSideLeftWallEdge - (gnPaddleRadius)) Then
  98.                         .x = (gnSideLeftWallEdge - (gnPaddleRadius))
  99.                     ElseIf .x < (gnSideRightWallEdge + (gnPaddleRadius)) Then
  100.                         .x = (gnSideRightWallEdge + (gnPaddleRadius))
  101.                     End If
  102.                 End With
  103.                 goPaddle(glMyPaddleID).Velocity.x = goPaddle(glMyPaddleID).Position.x - goPaddle(glMyPaddleID).LastPosition.x
  104.                 goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
  105.             End If
  106.         Case DIMOFS_Y 'We moved the Y axis
  107.             If gfMovingCamera Then
  108.                 With goCamera.Position
  109.                     .z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
  110.                     goCamera.SetCameraPosition CustomView, glMyPaddleID
  111.                     If Abs(.z) > mnMaxZThresh Then
  112.                         'Whoops too much
  113.                         .z = mnMaxZThresh * (.z / Abs(.z))
  114.                     End If
  115.                 End With
  116.             Else
  117.                 goPaddle(glMyPaddleID).LastPosition = goPaddle(glMyPaddleID).Position
  118.                 With goPaddle(glMyPaddleID).Position
  119.                     .z = .z - (diDeviceData(lCount).lData * mnMouseSensitivity)
  120.                     'The front and rear walls are count to the Z axis
  121.                     If glMyPaddleID = 0 Then
  122.                         If .z > -2 Then
  123.                             .z = -2
  124.                         ElseIf .z < (gnFarWallEdge + (gnPaddleRadius)) Then
  125.                             .z = (gnFarWallEdge + (gnPaddleRadius))
  126.                         End If
  127.                     Else
  128.                         If .z > (gnNearWallEdge - (gnPaddleRadius)) Then
  129.                             .z = (gnNearWallEdge - (gnPaddleRadius))
  130.                         ElseIf .z < 2 Then
  131.                             .z = 2
  132.                         End If
  133.                     End If
  134.                 End With
  135.                 goPaddle(glMyPaddleID).Velocity.z = goPaddle(glMyPaddleID).Position.z - goPaddle(glMyPaddleID).LastPosition.z
  136.                 goPaddle(glMyPaddleID).LastVelocityTick = timeGetTime
  137.             End If
  138.     
  139.         Case DIMOFS_BUTTON1
  140.             gfMovingCamera = (diDeviceData(lCount).lData And &H80 = &H80)
  141.     
  142.         End Select
  143.         EnsurePaddleReality vOldPaddle, goPaddle(glMyPaddleID)
  144.     Next lCount
  145.     Exit Sub
  146.     
  147. INPUTLOST:
  148.     If (Err.Number = DIERR_INPUTLOST) Or (Err.Number = DIERR_NOTACQUIRED) Then
  149.         'We no longer have the mouse..
  150.     End If
  151. End Sub
  152.  
  153. Public Sub GetAndHandleDinput()
  154.     'First let's handle the mouse
  155.     ProcessMouseData
  156.     'Now we can worry about keyboard
  157.     'If we have a joystick selected check that too
  158. End Sub
  159.